perm filename PLTIT.F4[MSS,LCS]3 blob sn#133856 filedate 1974-11-30 generic text, type T, neo UTF8
00001	C**** PLTCMD, FILLMS, ROTATE ********
00005		SUBROUTINE PLTCMD
00009	CC	IMPLICIT INTEGER(A-Q,S-Z)
00013		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK
00017		DIMENSION NMS(8),RMOV1(8),RMOV2(8)
00021		COMMON /DL/RSIZ,SAVER,NAME /ALF/INP(72),ML
00025		COMMON RJB,JE,CENTR,JB,RJQ(20),JQ(20)
00029		EQUIVALENCE (RJE,RJQ(3)),(RJF,RJQ(4)),(RJG,RJQ(5)),(RJD,RJQ(2))
00033		1,(RJC,RJQ(1)),(I2,INP(2)),(RJH,RJQ(6)),(NMS(1),INP(31))
00037		1,(RMOV1(1),INP(39))
00041	C  BE CAREFUL OF COMMON OVERLAPS WITH NOTWRT,ITMSUB,HOMER, ETC.
00045	CC	1,(RMOV1(1),INP(21)),(RMOV2(1),INP(31))
00049		F78F(1)='(78F)'
00053		FA5(1)='(A5) '
00057		FA1(1)='(A1) '
00061	
00065		IF(I2.NE.'X')GO TO 1
00073		I2=0
00077		RXC=0
01800		RMOV1(1)='Y'
01900		NAME=0
02000	14	KA=0
02100	3	KA=KA+1
02300		IF(ML.EQ.0)GO TO 15
02400		K=K-2
02500		ML=ML-1
02600		IF(ML.EQ.0)GO TO 10
02700		GO TO 31
02800	15	TYPE 2,KA
02900		ACCEPT 11,K,ML
03000	C  TYPE LAST NAME, NUMBER  FOR A SERIES
03100	50	IF(K.EQ.' ')GO TO 10
03200		IF(K.EQ.'99')GO TO 140
03300	C  99=BACKUP
03400	31	IF(LOOKD(K))GO TO 56
03500	C JUMP IF FILE FOUND
03600		TYPE 55
03700		GO TO 15
03800	55	FORMAT(' FILE NOT FOUND'/)
03900	11	FORMAT(A5,I)
04000	56	NMS(KA)=K
04200		IF(ML.EQ.0)GO TO 5
04300		RJH='Y'
04400		GO TO 21
04500	5	TYPE 8
04600		ACCEPT FA5,RJH
04700		IF(RJH.EQ.'99')GO TO 15
04800		IF(RJH.NE.'Y')RJH=0
04900		IF(RJH.EQ.0)REREAD F78F,RJH
05000	C  MOVE NUMBER CAN BE TYPED FOR 'MOVE UP'
05100	21	RMOV1(KA+1)=RJH
05200		RMOV2(KA)=RJH
05300		GO TO 3
05400	140	KA=KA-1
05500		GO TO 15
05600	
05700	10	KB=KA-1
05800		IF(I3.NE.'G')GO TO 22
05900		RSIZ=1
06000		GO TO 222
06100	22	TYPE 9
06200		ACCEPT F78F,RSIZ
06300		IF(RSIZ.EQ.99.OR.RSIZ.EQ.0)GO TO 5
06400	222	KA=0
06500	
06600	1	IF(NAME.NE.0)GO TO 12
06700		IF(KA.EQ.KB)CALL PLOT(0,0,99)
06800		NAME=NMS(KA+1)
06900		TYPE 111,NAME
07000		RETURN
07100	12	KA=KA+1
07200		NAME=0
07500	C  'PXC' = CALCOMP OUTPUT
07600		RJH=0
07700		RJB=RSIZ
07800		RJC=RSIZ
08000	C  FOR FILLER.  SIZES .LT. 1.6 = EVERY SCAN LINE, .LT. 2.6 = 2, ETC.
08100		RJG=0
08200		RJE=1
08300		RJF=1
08400		IF(RMOV2(KA).NE.'Y')RJG=RMOV2(KA)
08500		IF(RMOV1(KA).NE.0)RJE=0
08600		IF(RMOV2(KA).NE.0.OR.RJG.NE.0)RJF=0
08700	2	FORMAT(' TYPE FILE NAME',I2,1X$)
08800	8	FORMAT(' MOVE UP AT END? ',$)
08900	9	FORMAT(' SIZE FACTOR? ',$)
09000	111	FORMAT(1XA5/)
09100		END
09200	
09300	
09400	
09500	C******   CHANGE 3, 4 AND 5 TO JFCL IN DDT WHEN USING DISTORTION.(SEE 'LINES')
09600		SUBROUTINE FILLMS(L,IDAT,RJB,CENTR,RJF,RJG)
09700		COMMON/DL/RSIZ,SAVER,NAME
09800		COMMON/DST/BB,CC/FLM/X(200),Y(200),NX(200)
09900		DIMENSION IDAT(1)
10000		COMMON/PLTR/IPLT,RHT,DIS/LL/LL/STF/RR(8),RSTJC
10200	C MD=DISPLAY   MP=PLOTTER   MX=XGP
10250		DATA M2/2/
10300		DX=DIS
10400		RX=RHT
10500		D=RSTJC*RJF
10600		R=RSTJC*RJG
10700	4	GO TO 1
10800		C=CC
10900		B=BB
11000	C  SAVES IT.  IT WILL RETURN LATER.
11100		BB=B/DIS
11200		CC=1000
11300	1	KK=0
11400		DO 205 J=1,L
11500		CALL UNPACK(M,N,IDAT(J))
11600		KK=KK+1
11700		NX(KK)=0
11800		IF(LL.EQ.3)NX(KK)=3
11900		X(KK)=ROFF((RJB+D*M)*DIS)
12000		Y(KK)=ROFF((CENTR+R*N)*RHT)
12100	3	GO TO 205
12200		Y(KK)=Y(KK)*(C-BB*(ABS(X(KK))))
12300	C  FOR DISTORTION
12400	205	CONTINUE
12500		NX(1)=KK
12600		DIS=1.0
12700		RHT=DIS
12900		IF(IPLT)M=RSIZ+.4
13000		IF(M.LE.0)M=1
13050		IF(M.GT.M2)M=M2
13100	C  STOPS DISTORTION IN 'LINES'
13200	2	CALL FILLER(X,Y,NX,M)
13300		DIS=DX
13400		RHT=RX
13500	5	RETURN
13600	C  NEXT TO RESET DISTORTION FACT.
13700		BB=B
13800		CC=C
13900		RETURN
14000		END
14100	
14200		SUBROUTINE ROTATE(I,L)
14300		DIMENSION I(1)
14500		COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/STF/RR(8),RSTJC
14600		EQUIVALENCE (RJF,RJQ(4)),(RJG,RJQ(5)),(DEG,RJQ(7))
14700		RJG=RJG*RSTJC
14800		RJF=RJF*RSTJC
14900		N=I(L)
15000		KNT=601
15100	C  ROTATED DATA IS PUT BACK STARTING AT LOCATION 601.
15200		I(KNT)=N
15300		DO 1 K=L+1,N+L-1
15400		CALL UNPACK(J,M,I(K))
15500		X=J*RJF
15600		Y=M*RJG
15700		JJ=I(K)/100000000
15800		AX=ATAN2(X,Y)*57.29578
15900		HYP=SQRT(X**2+Y**2)
16000		ROT=DEG+AX
16100		J=ROFF(HYP*COSD(ROT))
16200		M=ROFF(HYP*SIND(ROT))
16300		KNT=KNT+1
16400		IF(J)J=1000-J
16500		IF(M)M=1000-M
16600	1	I(KNT)=M*10000+J+JJ*100000000
16700		L=601
16800		RJF=1.
16900		RJG=1.
17000		RSTJC=1.
17100	C  SIZE CHANGES MUST BE MADE BEFORE ROTATION!!!!! ELSE IT DISTORTS.
17200		END
20000	
20010		SUBROUTINE PLOT(J,K,L)
20020		CALL PLOTX(J,K,L)
20030		END
20040	C  TO ROTATE 90 DEG. CHANGE IN DDT AT 1M - 'JUMP J' TO 'JUMP K' AND VS-VS.
20100	
30000		SUBROUTINE PLOTX(I,J,K)
30200		DIMENSION N(128)
30210		IF(JJ)GO TO 4
30220		L=1
30237		N(1)=127
30255		CALL PUTFIL('PLT')
30277		JJ=-1
30300	4	IF(K.EQ.99)GO TO 1
30400		L=L+1
30500		CALL PAC(N(L),I)
30550	CC	N(L)=J+5000+(I+5000)*10000+(K+4)*100000000
30575	C PACKS   PX000Y000
30600	3	IF(L.LT.128)RETURN
30700	2	CALL FASTOU(N,128)
30800		L=1
30900		RETURN
31000	1	N(1)=L-1
31100		CALL FASTOU(N,128)
31200		CALL FINFIL
31250		JJ=0
31275		CALL EXIT
31300		END
31400	
31500		SUBROUTINE PLOTS(K)
31600	C  DUMMY
31700		END